home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue45 / Running / IDERunU.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2000-11-02  |  4.4 KB  |  180 lines
  1. unit IDERunU;
  2.  
  3. interface
  4.  
  5. uses
  6.   WinProcs, WinTypes, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  7.   Dialogs, StdCtrls, ExtCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     chkDelphi1: TCheckBox;
  12.     chkDelphi32: TCheckBox;
  13.     chkDelphiDebugger: TCheckBox;
  14.     chkDelphiRunning: TCheckBox;
  15.     chkDelphiLaunchedMe: TCheckBox;
  16.     procedure FormCreate(Sender: TObject);
  17.   private
  18.     { Private declarations }
  19.   public
  20.     { Public declarations }
  21.   end;
  22.  
  23. var
  24.   Form1: TForm1;
  25.  
  26. implementation
  27.  
  28. uses
  29. {$ifdef Win32}
  30.   Registry,
  31. {$endif}
  32.   IniFiles;
  33.  
  34. {$R *.DFM}
  35.  
  36. function Delphi1Exists: Boolean;
  37. var
  38.   LibName: String;
  39. begin
  40.   with TIniFile.Create('DELPHI.INI') do
  41.     try
  42.       LibName := ReadString('Library', 'ComponentLibrary', '');
  43.       Result := (LibName <> '') and FileExists(LibName)
  44.     finally
  45.       Free
  46.     end;
  47. end;
  48.  
  49. {$ifdef Win32}
  50. function Delphi32Exists: Boolean;
  51. var
  52.   Reg: TRegistry;
  53.   Keys, Values: TStrings;
  54.   KeyLoop, ValueLoop: Integer;
  55. const
  56.   DelphiPath = 'Software\Borland\Delphi\';
  57. begin
  58.   Result := False;
  59.   Reg := TRegistry.Create;
  60.   Keys := TStringList.Create;
  61.   Values := TStringList.Create;
  62.   try
  63.     Reg.RootKey := HKEY_LOCAL_MACHINE;
  64.     if Reg.OpenKey(DelphiPath, False) and Reg.HasSubKeys then
  65.     begin
  66.       //There may be more than one Delphi section
  67.       Reg.GetKeyNames(Keys);
  68.       Reg.CloseKey;
  69.       for KeyLoop := 0 to Keys.Count - 1 do
  70.         if not Result and Reg.OpenKey(DelphiPath + Keys[KeyLoop], False) then
  71.           try
  72.             Reg.GetValueNames(Values);
  73.             for ValueLoop := 0 to Values.Count - 1 do
  74.             begin
  75.               Result := (Pos('Delphi', Values[ValueLoop]) > 0) and
  76.                         FileExists(Reg.ReadString(Values[ValueLoop]));
  77.               if Result then Break
  78.             end;
  79.           finally
  80.             Reg.CloseKey
  81.           end
  82.     end
  83.   finally
  84.     Reg.Free;
  85.     Keys.Free;
  86.     Values.Free
  87.   end
  88. end;
  89. {$endif}
  90.  
  91. {$ifndef WIN32}
  92. type
  93.   { Used by TDebugRec }
  94.   TExceptionKind = (evNull, evRaise, evExcept, evFinally,
  95.                     evUnexpected, evTerminate);
  96.  
  97.   { Used by DebuggerRunning }
  98.   PDebugRec = ^TDebugRec;
  99.   TDebugRec = record
  100.     dhMagic1,
  101.     dhZero,
  102.     dhMagic2,
  103.     dhHookProc,
  104.     dhDebugHooked: Longint;
  105.     dhKind: Word; { Use TExceptionKind enumerated type above }
  106.     dhAddr,
  107.     dhCookie,
  108.     dhNameLen,
  109.     dhName,
  110.     dhMsgLen,
  111.     dhMsg,
  112.     dhWantException,
  113.     dhDoneExcept: Longint;
  114.   end;
  115.  
  116. const
  117.   DebuggerHook  = $24; { Offset in DS of pointer to debugger data }
  118. {$endif}
  119.  
  120. { Checks if debugger is active (it swallows notifications) }
  121. function DelphiDebuggerRunning: Boolean;
  122. begin
  123. {$ifndef WIN32}
  124.   Result := (PrefixSeg <> 0) and
  125.     (LoWord(PDebugRec(Ptr(DSeg, DebuggerHook)^)^.dhDebugHooked) <> 0);
  126.   { You can dispense with all these type definitions }
  127.   { by using the following piece of code instead: }
  128.   { Result := Bool(PrefixSeg) and Bool(PWordArray(MemL[DSeg:36])^[8]) }
  129. {$else}
  130.   Result := DebugHook <> 0;
  131. {$endif}
  132. end;
  133.  
  134. function DelphiRunning: Boolean;
  135. begin
  136.   Result :=
  137.     Bool(FindWindow('TAppBuilder', nil)) and
  138.     Bool(FindWindow('TPropertyInspector', nil)) and
  139.     Bool(FindWindow('TMenuBuilder', nil)) and
  140.     Bool(FindWindow('TAlignPalette', nil));
  141. end;
  142.  
  143. function DelphiLaunchedMe: Boolean;
  144. var
  145.   Wnd: HWnd;
  146.   CCaption: array[0..255] of Char;
  147.   FileName, Caption: String;
  148. begin
  149.   Result := False;
  150.   if DelphiRunning then
  151.   begin
  152.     { Get Delphi's main window }
  153.     Wnd := FindWindow('TAppBuilder', nil);
  154.     { Read its caption }
  155.     GetWindowText(Wnd, CCaption, SizeOf(CCaption));
  156.     { Translate the C string into a Pascal string, upper cased }
  157.     Caption := UpperCase(StrPas(CCaption));
  158.     { Find the root part of this project name... }
  159.     FileName := ExtractFileName(Application.ExeName);
  160.     { ...without the extension }
  161.     FileName := Copy(FileName, 1, Length(FileName) - 4);
  162.     { If Delphi has my project name in its caption, then we win }
  163.     Result := Pos(FileName, Caption) <> 0;
  164.   end
  165. end;
  166.  
  167. procedure TForm1.FormCreate(Sender: TObject);
  168. begin
  169.   chkDelphi1.Checked := Delphi1Exists;
  170. {$ifdef Win32}
  171.   chkDelphi32.Checked := Delphi32Exists;
  172. {$else}
  173.   chkDelphi32.Enabled := False;
  174. {$endif}
  175.   chkDelphiRunning.Checked := DelphiRunning;
  176.   chkDelphiDebugger.Checked := DelphiDebuggerRunning;
  177.   chkDelphiLaunchedMe.Checked := DelphiLaunchedMe
  178. end;
  179.  
  180. end.